home *** CD-ROM | disk | FTP | other *** search
/ Aminet 24 / Aminet 24 (1998)(GTI - Schatztruhe)[!][Apr 1998].iso / Aminet / dev / c / AmiVoGL_MDEV.lha / examples / fmoretxt.F < prev    next >
Text File  |  1991-06-03  |  4KB  |  227 lines
  1. c
  2. c drawgr
  3. c
  4. c    draw a grid in the middle of the screen
  5. c
  6.     subroutine drawgr
  7.  
  8. #ifdef SGI
  9. #include "fgl.h"
  10. #else
  11. #include "fvogl.h"
  12. #endif
  13.  
  14.     real x
  15.  
  16.  
  17.     call color(GREEN)
  18.  
  19.     call rect(0.1, 0.4, 0.9, 0.6)
  20.  
  21.     x = 0.2
  22.  
  23.     do 10 i = 1, 8
  24.         call move2(x, 0.4)
  25.         call draw2(x, 0.6)
  26.         x = x + 0.1
  27. 10    continue
  28.  
  29.     call move2(0.1, 0.5)
  30.     call draw2(0.9, 0.5)
  31.  
  32.     call color(YELLOW)
  33.  
  34.     end
  35.  
  36. c
  37. c demonstrate some more features of text
  38. c
  39.     program    fmtxt
  40.  
  41. #ifdef SGI
  42. #include "fgl.h"
  43. #include "fdevice.h"
  44. #else
  45. #include "fvogl.h"
  46. #include "fvodevice.h"
  47. #endif
  48.  
  49.     character fname*80
  50.     integer *2 val
  51.  
  52.     print*,'Enter a font name:'
  53.     read(*,'(a)') fname
  54.  
  55.     call prefsi(512, 512)
  56.     call winope('fmoretxt', 8)
  57.  
  58. c
  59. c We are interested in Keyboard events...
  60. c
  61.     call unqdev(INPUTC)
  62.     call qdevic(KEYBD)
  63.  
  64.     call hfont(fname, nchars(fname))
  65.  
  66.     call ortho2(0.0, 1.0, 0.0, 1.0)
  67.  
  68.     call color(BLACK)
  69.     call clear
  70.  
  71.     call drawgr
  72.  
  73. c
  74. c show some scaled text on the grid (In the bottom part)
  75. c
  76.     call hboxte(0.1, 0.4, 0.8, 0.1,
  77.      +      '{This is Some text] | $', 23)
  78.  
  79.     idum = qread(val)
  80.  
  81.     call color(BLACK)
  82.     call clear
  83.  
  84.     call drawgr
  85.  
  86. c
  87. c centertext causes text to be centered around the current graphics
  88. c position this is especially usefull if you want your text to come
  89. c out centered on a line, or a character to be centered on a point
  90. c in a graph. A non-zero (.true.) argument turns centertext on.
  91. c
  92. c show a string centered on the center line
  93. c
  94.     call hcente(.true.)
  95.  
  96.     call hboxte(0.5, 0.5, 0.8, 0.1,
  97.      +      '{This is Some Centered text] | $', 31)
  98. c
  99. c turn centertext off. We use an argument with the value zero (.false.).
  100. c
  101.     call hcente(.false.)
  102.  
  103.     idum = qread(val)
  104.  
  105.     call color(BLACK)
  106.     call clear
  107.  
  108. c
  109. c rotate the grid so that it is the same angle as the text after
  110. c textang for text ang.
  111. c
  112.     call pushma
  113.         call transl(0.5, 0.5, 0.0)
  114.         call rotate(900, 'z')
  115.         call transl(-0.5, -0.5, 0.0)
  116.  
  117.         call drawgr
  118.     call popmat
  119.  
  120. c
  121. c turn on centered text again
  122. c
  123.     call hcente(.true.)
  124.  
  125. c
  126. c set the angle to 90.
  127. c
  128.     call htexta(90.0)
  129.  
  130. c
  131. c draw the string
  132. c
  133.     call htexts(0.05, 0.05)
  134.     call hboxte(0.5, 0.5, 0.8, 0.1,
  135.      +      '{This is Some Rotated Centered text] | $', 39)
  136. c
  137. c turn off center text
  138. c
  139.     call hcente(.false.)
  140.  
  141. c
  142. c set text angle back to 90
  143. c
  144.     call htexta(0.0)
  145.  
  146.     idum = qread(val)
  147.  
  148.     call color(BLACK)
  149.     call clear
  150.  
  151.     call drawgr
  152.  
  153. c
  154. c as all the software fonts are proportionally spaced we use
  155. c the fixedwidth call to make each character take the same amount
  156. c of horizontal space. As with centertext this is done by passing
  157. c fixedwidth a non-zero (.true.) argument.
  158. c
  159.     call hfixed(.true.)
  160.  
  161.     call hboxte(0.1, 0.5, 0.8, 0.1,
  162.      +      '{This is Some Fixedwidth text] | $', 33)
  163.  
  164.     idum = qread(val)
  165.  
  166.     call color(BLACK)
  167.     call clear
  168.  
  169.     call drawgr
  170.  
  171. c
  172. c now try centered and fixewidth at the same time
  173. c
  174.     call hcente(.true.)
  175.  
  176.     call move2(0.5, 0.5)
  177.     call hchars('{This is Some Cent.Fixedwidth text] | $', 38)
  178.  
  179.     call hcente(.false.)
  180.     
  181.     idum = qread(val)
  182.     call color(BLACK)
  183.     call clear
  184.  
  185.     call drawgr
  186.  
  187. c
  188. c scale the text so tha a character is the size of a box in
  189. c the grid.
  190. c
  191.     call hboxfi(0.8, 0.1, 8)
  192.  
  193. c
  194. c draw the two strings fixedwidth (it is still turned on)
  195. c
  196.     call move2(0.1, 0.4)
  197.     call hchars('ABCDefgh', 8)
  198.  
  199.     call move2(0.1, 0.5)
  200.     call hchars('IJKLmnop', 8)
  201.  
  202.     idum = qread(val)
  203.  
  204.     call gexit
  205.  
  206.     end
  207. c
  208. c nchars
  209. c
  210. c return the real length of a string padded with blanks
  211. c
  212.     integer function nchars(str)
  213.     character *(*) str
  214.  
  215.     do 10 i = len(str), 1, -1
  216.         if (str(i:i) .ne. ' ') then
  217.             nchars = i
  218.             return
  219.         end if
  220. 10      continue
  221.  
  222.     nchars = 0
  223.  
  224.     return
  225.  
  226.     end
  227.